home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / Progreso.tcl < prev    next >
Encoding:
Text File  |  2004-02-21  |  6.3 KB  |  175 lines
  1. ###############################################################################
  2. ###############################################################################
  3. #####                            Progreso.tcl
  4. ###############################################################################
  5. ##### Namespace for creating and managing progress bars.
  6. ###############################################################################
  7. ##### Copyright 2001 AndrΘs Garcφa Garcφa - fandom@retemail.es
  8. ##### Distributed under the terms of the LGPL v2
  9. ###############################################################################
  10.  
  11. namespace eval Progreso {
  12.  
  13. ###############################################################################
  14. # ProgressBar
  15. #    Creates the progress bar.
  16. #
  17. # Parameter
  18. #    path: path of the progress bar.
  19. #    args: list with the parameters for the bar:
  20. #            - width: Default 275 pixels.
  21. #            - height: Default 13 pixels.
  22. #            - numbers: whether to show the percentage or not, default: '1'.
  23. #            - bg: background color, defaults to white.
  24. #            - fg: color that fills the bar, defaults to blue.
  25. #
  26. # Returns
  27. #    path of the progress bar.
  28. ###############################################################################
  29. proc ProgressBar {path args} {
  30.     variable pbArgs
  31.  
  32.     ParseArguments $path $args
  33.  
  34.     set barFrame [frame $path]
  35.     set whiteCanvas [canvas $barFrame.white -bg $pbArgs($path,-bg)      \
  36.             -highlightthickness 0 -bd 2 -relief sunken                  \
  37.             -width $pbArgs($path,-width) -height $pbArgs($path,-height)]
  38.     set blueCanvas  [canvas $barFrame.blue  -bg $pbArgs($path,-fg)      \
  39.             -highlightthickness 0]
  40.  
  41.     pack $whiteCanvas
  42.     update
  43.  
  44.     return $barFrame
  45. }
  46.  
  47. ###############################################################################
  48. # ParseArguments
  49. #    Gets the optional parameters passed to the progress bar into the
  50. #    namespace variable 'pbArgs', the rest get the default values.
  51. ###############################################################################
  52. proc ParseArguments {path parameters} {
  53.     variable pbArgs
  54.  
  55.     set pbArgs($path,-width)   275
  56.     set pbArgs($path,-height)  12
  57.     set pbArgs($path,-numbers) 1
  58.     set pbArgs($path,-bg)      white
  59.     set pbArgs($path,-fg)      blue
  60.     if {$::tcl_platform(platform)=="windows"} {
  61.         set pbArgs($path,-font) {"MS Sans Serif" 8}
  62.     } else {
  63.         set pbArgs($path,-font) {"Helvetica" 12}
  64.     }
  65.  
  66.     foreach {parameter value} $parameters {
  67.         set pbArgs($path,$parameter) $value
  68.     }
  69.  
  70.     return
  71. }
  72.  
  73. ###############################################################################
  74. # ProgressBarUpdate
  75. #    Updates the progress bar.
  76. #
  77. # Parameter
  78. #    path of the progress bar.
  79. #    percen: porcentage of the task that has already been completed.
  80. ###############################################################################
  81. proc ProgressBarUpdate {path percen} {
  82.     variable pbArgs
  83.  
  84.     set pbArgs($path,-width) [winfo width $path.white]
  85.     set done [expr {($pbArgs($path,-width)-4) * $percen/100}]
  86.     if {$pbArgs($path,-numbers)==1} {
  87.         set pbArgs($path,blackX) [expr {int($pbArgs($path,-width)/2)+2}]
  88.         set pbArgs($path,blackY) [expr {int($pbArgs($path,-height)/2)+2}]
  89.         set pbArgs($path,whiteX) [expr {int($pbArgs($path,-width)/2)}]
  90.         set pbArgs($path,whiteY) [expr {int($pbArgs($path,-height)/2)}]
  91.     }
  92.     place $path.blue -in $path.white -x 2 -y 2 -bordermode inside \
  93.             -width $done -height $pbArgs($path,-height)
  94.  
  95.     if {$pbArgs($path,-numbers)==0} return
  96.  
  97.     if {[info exists pbArgs($path,blackNumber)]} {
  98.         $path.white delete $pbArgs($path,blackNumber)
  99.         $path.blue  delete $pbArgs($path,whiteNumber)
  100.     }
  101.     set pbArgs($path,blackNumber) [$path.white create text \
  102.             $pbArgs($path,blackX) $pbArgs($path,blackY)    \
  103.             -text $percen% -fill black -anchor c -font $pbArgs($path,-font)]
  104.     set pbArgs($path,whiteNumber) [$path.blue  create text \
  105.             $pbArgs($path,whiteX) $pbArgs($path,whiteY)    \
  106.             -text $percen% -fill white -anchor c -font $pbArgs($path,-font)]
  107.  
  108.     return
  109. }
  110.  
  111. ###############################################################################
  112. # ProgressBarReset
  113. #    Puts the progress bar back to 0%.
  114. #
  115. # Parameter
  116. #    path of the progress bar.
  117. ###############################################################################
  118. proc ProgressBarReset {path} {
  119.     variable pbArgs
  120.  
  121.     place forget $path.blue
  122.     catch {$path.white delete $pbArgs($path,blackNumber)}
  123.  
  124.     return
  125. }
  126.  
  127. ###############################################################################
  128. # ProgressBarFull
  129. #    Puts the progress bar at 100%.
  130. #
  131. # Parameter
  132. #    path of the progress bar.
  133. ###############################################################################
  134. proc ProgressBarFull {path} {
  135.  
  136.     ProgressBarUpdate $path 100
  137.  
  138.     return
  139. }
  140. }
  141.  
  142. ###############################################################################
  143. ###############################################################################
  144. #######                            Example
  145. ###############################################################################
  146. ###############################################################################
  147. #proc StartCount {path percen} {
  148. #    global progressId
  149. #    Progreso::ProgressBarUpdate $path $percen
  150. #    if {$percen<100} {
  151. #        set progressId [after 250 "StartCount $path [incr percen 1]"]
  152. #    }
  153. #    return
  154. #}
  155. #set barFrame [frame .barFrame -relief groove -bd 2]
  156. #set progreso [Progreso::ProgressBar $barFrame.progreso -width 300 -height 35 \
  157.         -font {"Times new Roman" 20 bold}]
  158. #set butFrame [frame .butFrame]
  159. #set start  [button $butFrame.start  -text Start  -width 6\
  160.         -command "StartCount $progreso 1"]
  161. #set reset  [button $butFrame.reset  -text Reset  -width 6\
  162.         -command "Progreso::ProgressBarReset $progreso"]
  163. #set full   [button $butFrame.full   -text Full   -width 6\
  164.         -command "Progreso::ProgressBarFull $progreso"]
  165. #set cancel [button $butFrame.cancel -text Cancel -width 6\
  166.         -command {after cancel $progressId}]
  167.  
  168. #pack $barFrame -padx 10 -pady 5
  169. #pack $progreso -padx 10 -pady 5
  170. #pack $butFrame -padx 7 -fill x
  171. #pack $start $reset $full $cancel -side right -padx 3
  172. ###############################################################################
  173. ###############################################################################
  174.  
  175.